sapply(split(pd,groups),sum)*100/sum(pd)
}
#Change H1 (base) to H2, H3 or H4
ages <- read.table("taxon_ages_lateral.txt",sep="\t",head=TRUE)
epoch <- read.table("bin_ranges_epoch.txt",sep="\t",head=TRUE)
group_data <- read.table("lateral_group_SynSaur_h1.txt", row.names=1, header=T)
pca_scores$Clade <- as.factor(group_data[,1])
pd_through_t <- matrix(NA,nrow=nlevels(pca_scores$Clade),ncol=nrow(epoch)) #Clade partial disparity per time bin
pd_through_t_perc <- matrix(NA,nrow=nlevels(pca_scores$Clade),ncol=nrow(epoch))
rownames(pd_through_t) <- rownames(pd_through_t_perc) <- levels(pca_scores$Clade)
colnames(pd_through_t) <- colnames(pd_through_t_perc) <- epoch[,1]
for(i in seq_along(epoch$Stage)){
pca_scores_stage <- pca_scores[ages$FAD>=epoch$min.age[i]&ages$LAD<=epoch$max.age[i],]
pca_stage <- prcomp(pca_scores_stage[,1:40],scale. = T)
pd_through_t_perc[,i] <- partial.disparity.as.percentage(pca_stage$x,pca_scores_stage$Clade)
}
pd_through_t_perc
stratplot <- function(xlim){
load("ics2023.Rdata")
plot(NA,xaxs="i",yaxs="i",xlim=xlim,ylim=c(0,3),ax=FALSE,ann=FALSE)
period <- ics[ics$Type=="Period",]
for(i in 1:nrow(period)){
rect(period$Start[i]/1e6,0,period$End[i]/1e6,1,col=period$Color[i])
text((period$Start[i]/1e6+period$End[i]/1e6)/2,.5,period$Name[i])
}
stage <- ics[ics$Type=="Stage",]
stage$Name <- gsub(" .+$","",stage$Name)
for(i in 1:nrow(stage)){
rect(stage$Start[i]/1e6,1,stage$End[i]/1e6,3,col=stage$Color[i])
text((stage$Start[i]/1e6+stage$End[i]/1e6)/2,2,stage$Name[i],cex=1,srt=90)
}
box(lwd=1.5)
axis(1,cex.axis=0.7,at=seq(0,350,1),labels=FALSE)
axis(1,cex.axis=0.7,at=seq(0,350,5),labels=FALSE,lwd=1.5)
axis(1,cex.axis=1,at=seq(0,350,10),lwd=1.5)
mtext("Age (Ma)",1,2.5,cex=1)
}
#Plots
cols <- c('lightgoldenrod','chartreuse','deepskyblue')
layout(matrix(1:2,ncol=1),height=c(2,1))
par(mar=c(0,5,1,5))
plot(NA,xlim=c(346.7,252.2),ylim=c(0,100),xaxs="i",yaxs="i",ann=FALSE,ax=FALSE)
pl <- cbind(c(100,0,0,0,0),pd_through_t_perc,pd_through_t_perc[,ncol(pd_through_t_perc)])
midp <- c(346.7,apply(epoch[,2:3],1,mean),252.2)
pl <- apply(pl,2,cumsum)
for(i in 1:nrow(pl)){
if(i==1){
polygon(c(midp,252.2,346.7),c(pl[i,],0,0),col=cols[i])
}else{
polygon(c(midp,rev(midp)),c(pl[i,],rev(pl[i-1,])),col=cols[i])
}
}
axis(2,at=c(0,25,50,75,100),labels=c("0","0.25","0.5","0.75","1"),las=2)
box(lwd=2)
par(mar=c(5,5,0,5))
stratplot(xlim=c(346.7,252.2))
dev.off()
dev.new()
partial.disparity <- function(X,groups){ #Partial disparity (as fraction)
centroid <- colMeans(X)
pd <- as.matrix(dist(rbind(X,centroid)))[1:nrow(X),-(1:ncol(X))]^2 / (nrow(X)-1)
sapply(split(pd,groups),sum)
}
partial.disparity.as.percentage <- function(X,groups){ #Partial disparity (as percentage)
centroid <- colMeans(X)
pd <- as.matrix(dist(rbind(X,centroid)))[1:nrow(X),-(1:ncol(X))]^2 / (nrow(X)-1)
sapply(split(pd,groups),sum)*100/sum(pd)
}
#Change H1 (base) to H2, H3 or H4
ages <- read.table("taxon_ages_lateral.txt",sep="\t",head=TRUE)
epoch <- read.table("bin_ranges_epoch.txt",sep="\t",head=TRUE)
group_data <- read.table("lateral_group_SynSaur_h2.txt", row.names=1, header=T)
pca_scores$Clade <- as.factor(group_data[,1])
pd_through_t <- matrix(NA,nrow=nlevels(pca_scores$Clade),ncol=nrow(epoch)) #Clade partial disparity per time bin
pd_through_t_perc <- matrix(NA,nrow=nlevels(pca_scores$Clade),ncol=nrow(epoch))
rownames(pd_through_t) <- rownames(pd_through_t_perc) <- levels(pca_scores$Clade)
colnames(pd_through_t) <- colnames(pd_through_t_perc) <- epoch[,1]
for(i in seq_along(epoch$Stage)){
pca_scores_stage <- pca_scores[ages$FAD>=epoch$min.age[i]&ages$LAD<=epoch$max.age[i],]
pca_stage <- prcomp(pca_scores_stage[,1:40],scale. = T)
pd_through_t_perc[,i] <- partial.disparity.as.percentage(pca_stage$x,pca_scores_stage$Clade)
}
pd_through_t_perc
stratplot <- function(xlim){
load("ics2023.Rdata")
plot(NA,xaxs="i",yaxs="i",xlim=xlim,ylim=c(0,3),ax=FALSE,ann=FALSE)
period <- ics[ics$Type=="Period",]
for(i in 1:nrow(period)){
rect(period$Start[i]/1e6,0,period$End[i]/1e6,1,col=period$Color[i])
text((period$Start[i]/1e6+period$End[i]/1e6)/2,.5,period$Name[i])
}
stage <- ics[ics$Type=="Stage",]
stage$Name <- gsub(" .+$","",stage$Name)
for(i in 1:nrow(stage)){
rect(stage$Start[i]/1e6,1,stage$End[i]/1e6,3,col=stage$Color[i])
text((stage$Start[i]/1e6+stage$End[i]/1e6)/2,2,stage$Name[i],cex=1,srt=90)
}
box(lwd=1.5)
axis(1,cex.axis=0.7,at=seq(0,350,1),labels=FALSE)
axis(1,cex.axis=0.7,at=seq(0,350,5),labels=FALSE,lwd=1.5)
axis(1,cex.axis=1,at=seq(0,350,10),lwd=1.5)
mtext("Age (Ma)",1,2.5,cex=1)
}
#Plots
cols <- c('lightgoldenrod','chartreuse','deepskyblue')
layout(matrix(1:2,ncol=1),height=c(2,1))
par(mar=c(0,5,1,5))
plot(NA,xlim=c(346.7,252.2),ylim=c(0,100),xaxs="i",yaxs="i",ann=FALSE,ax=FALSE)
pl <- cbind(c(100,0,0,0,0),pd_through_t_perc,pd_through_t_perc[,ncol(pd_through_t_perc)])
midp <- c(346.7,apply(epoch[,2:3],1,mean),252.2)
pl <- apply(pl,2,cumsum)
for(i in 1:nrow(pl)){
if(i==1){
polygon(c(midp,252.2,346.7),c(pl[i,],0,0),col=cols[i])
}else{
polygon(c(midp,rev(midp)),c(pl[i,],rev(pl[i-1,])),col=cols[i])
}
}
axis(2,at=c(0,25,50,75,100),labels=c("0","0.25","0.5","0.75","1"),las=2)
box(lwd=2)
par(mar=c(5,5,0,5))
stratplot(xlim=c(346.7,252.2))
dev.off()
dev.new()
partial.disparity <- function(X,groups){ #Partial disparity (as fraction)
centroid <- colMeans(X)
pd <- as.matrix(dist(rbind(X,centroid)))[1:nrow(X),-(1:ncol(X))]^2 / (nrow(X)-1)
sapply(split(pd,groups),sum)
}
partial.disparity.as.percentage <- function(X,groups){ #Partial disparity (as percentage)
centroid <- colMeans(X)
pd <- as.matrix(dist(rbind(X,centroid)))[1:nrow(X),-(1:ncol(X))]^2 / (nrow(X)-1)
sapply(split(pd,groups),sum)*100/sum(pd)
}
#Change H1 (base) to H2, H3 or H4
ages <- read.table("taxon_ages_lateral.txt",sep="\t",head=TRUE)
epoch <- read.table("bin_ranges_epoch.txt",sep="\t",head=TRUE)
group_data <- read.table("lateral_group_SynSaur_h3.txt", row.names=1, header=T)
pca_scores$Clade <- as.factor(group_data[,1])
pd_through_t <- matrix(NA,nrow=nlevels(pca_scores$Clade),ncol=nrow(epoch)) #Clade partial disparity per time bin
pd_through_t_perc <- matrix(NA,nrow=nlevels(pca_scores$Clade),ncol=nrow(epoch))
rownames(pd_through_t) <- rownames(pd_through_t_perc) <- levels(pca_scores$Clade)
colnames(pd_through_t) <- colnames(pd_through_t_perc) <- epoch[,1]
for(i in seq_along(epoch$Stage)){
pca_scores_stage <- pca_scores[ages$FAD>=epoch$min.age[i]&ages$LAD<=epoch$max.age[i],]
pca_stage <- prcomp(pca_scores_stage[,1:40],scale. = T)
pd_through_t_perc[,i] <- partial.disparity.as.percentage(pca_stage$x,pca_scores_stage$Clade)
}
pd_through_t_perc
stratplot <- function(xlim){
load("ics2023.Rdata")
plot(NA,xaxs="i",yaxs="i",xlim=xlim,ylim=c(0,3),ax=FALSE,ann=FALSE)
period <- ics[ics$Type=="Period",]
for(i in 1:nrow(period)){
rect(period$Start[i]/1e6,0,period$End[i]/1e6,1,col=period$Color[i])
text((period$Start[i]/1e6+period$End[i]/1e6)/2,.5,period$Name[i])
}
stage <- ics[ics$Type=="Stage",]
stage$Name <- gsub(" .+$","",stage$Name)
for(i in 1:nrow(stage)){
rect(stage$Start[i]/1e6,1,stage$End[i]/1e6,3,col=stage$Color[i])
text((stage$Start[i]/1e6+stage$End[i]/1e6)/2,2,stage$Name[i],cex=1,srt=90)
}
box(lwd=1.5)
axis(1,cex.axis=0.7,at=seq(0,350,1),labels=FALSE)
axis(1,cex.axis=0.7,at=seq(0,350,5),labels=FALSE,lwd=1.5)
axis(1,cex.axis=1,at=seq(0,350,10),lwd=1.5)
mtext("Age (Ma)",1,2.5,cex=1)
}
#Plots
cols <- c('lightgoldenrod','chartreuse','deepskyblue')
layout(matrix(1:2,ncol=1),height=c(2,1))
par(mar=c(0,5,1,5))
plot(NA,xlim=c(346.7,252.2),ylim=c(0,100),xaxs="i",yaxs="i",ann=FALSE,ax=FALSE)
pl <- cbind(c(100,0,0,0,0),pd_through_t_perc,pd_through_t_perc[,ncol(pd_through_t_perc)])
midp <- c(346.7,apply(epoch[,2:3],1,mean),252.2)
pl <- apply(pl,2,cumsum)
for(i in 1:nrow(pl)){
if(i==1){
polygon(c(midp,252.2,346.7),c(pl[i,],0,0),col=cols[i])
}else{
polygon(c(midp,rev(midp)),c(pl[i,],rev(pl[i-1,])),col=cols[i])
}
}
axis(2,at=c(0,25,50,75,100),labels=c("0","0.25","0.5","0.75","1"),las=2)
box(lwd=2)
par(mar=c(5,5,0,5))
stratplot(xlim=c(346.7,252.2))
dev.off()
dev.new()
partial.disparity <- function(X,groups){ #Partial disparity (as fraction)
centroid <- colMeans(X)
pd <- as.matrix(dist(rbind(X,centroid)))[1:nrow(X),-(1:ncol(X))]^2 / (nrow(X)-1)
sapply(split(pd,groups),sum)
}
partial.disparity.as.percentage <- function(X,groups){ #Partial disparity (as percentage)
centroid <- colMeans(X)
pd <- as.matrix(dist(rbind(X,centroid)))[1:nrow(X),-(1:ncol(X))]^2 / (nrow(X)-1)
sapply(split(pd,groups),sum)*100/sum(pd)
}
#Change H1 (base) to H2, H3 or H4
ages <- read.table("taxon_ages_lateral.txt",sep="\t",head=TRUE)
epoch <- read.table("bin_ranges_epoch.txt",sep="\t",head=TRUE)
group_data <- read.table("lateral_group_SynSaur_h4.txt", row.names=1, header=T)
pca_scores$Clade <- as.factor(group_data[,1])
pd_through_t <- matrix(NA,nrow=nlevels(pca_scores$Clade),ncol=nrow(epoch)) #Clade partial disparity per time bin
pd_through_t_perc <- matrix(NA,nrow=nlevels(pca_scores$Clade),ncol=nrow(epoch))
rownames(pd_through_t) <- rownames(pd_through_t_perc) <- levels(pca_scores$Clade)
colnames(pd_through_t) <- colnames(pd_through_t_perc) <- epoch[,1]
for(i in seq_along(epoch$Stage)){
pca_scores_stage <- pca_scores[ages$FAD>=epoch$min.age[i]&ages$LAD<=epoch$max.age[i],]
pca_stage <- prcomp(pca_scores_stage[,1:40],scale. = T)
pd_through_t_perc[,i] <- partial.disparity.as.percentage(pca_stage$x,pca_scores_stage$Clade)
}
pd_through_t_perc
stratplot <- function(xlim){
load("ics2023.Rdata")
plot(NA,xaxs="i",yaxs="i",xlim=xlim,ylim=c(0,3),ax=FALSE,ann=FALSE)
period <- ics[ics$Type=="Period",]
for(i in 1:nrow(period)){
rect(period$Start[i]/1e6,0,period$End[i]/1e6,1,col=period$Color[i])
text((period$Start[i]/1e6+period$End[i]/1e6)/2,.5,period$Name[i])
}
stage <- ics[ics$Type=="Stage",]
stage$Name <- gsub(" .+$","",stage$Name)
for(i in 1:nrow(stage)){
rect(stage$Start[i]/1e6,1,stage$End[i]/1e6,3,col=stage$Color[i])
text((stage$Start[i]/1e6+stage$End[i]/1e6)/2,2,stage$Name[i],cex=1,srt=90)
}
box(lwd=1.5)
axis(1,cex.axis=0.7,at=seq(0,350,1),labels=FALSE)
axis(1,cex.axis=0.7,at=seq(0,350,5),labels=FALSE,lwd=1.5)
axis(1,cex.axis=1,at=seq(0,350,10),lwd=1.5)
mtext("Age (Ma)",1,2.5,cex=1)
}
#Plots
cols <- c('lightgoldenrod','chartreuse','deepskyblue')
layout(matrix(1:2,ncol=1),height=c(2,1))
par(mar=c(0,5,1,5))
plot(NA,xlim=c(346.7,252.2),ylim=c(0,100),xaxs="i",yaxs="i",ann=FALSE,ax=FALSE)
pl <- cbind(c(100,0,0,0,0),pd_through_t_perc,pd_through_t_perc[,ncol(pd_through_t_perc)])
midp <- c(346.7,apply(epoch[,2:3],1,mean),252.2)
pl <- apply(pl,2,cumsum)
for(i in 1:nrow(pl)){
if(i==1){
polygon(c(midp,252.2,346.7),c(pl[i,],0,0),col=cols[i])
}else{
polygon(c(midp,rev(midp)),c(pl[i,],rev(pl[i-1,])),col=cols[i])
}
}
axis(2,at=c(0,25,50,75,100),labels=c("0","0.25","0.5","0.75","1"),las=2)
box(lwd=2)
par(mar=c(5,5,0,5))
stratplot(xlim=c(346.7,252.2))
dev.off()
dev.new()
partial.disparity <- function(X,groups){ #Partial disparity (as fraction)
centroid <- colMeans(X)
pd <- as.matrix(dist(rbind(X,centroid)))[1:nrow(X),-(1:ncol(X))]^2 / (nrow(X)-1)
sapply(split(pd,groups),sum)
}
partial.disparity.as.percentage <- function(X,groups){ #Partial disparity (as percentage)
centroid <- colMeans(X)
pd <- as.matrix(dist(rbind(X,centroid)))[1:nrow(X),-(1:ncol(X))]^2 / (nrow(X)-1)
sapply(split(pd,groups),sum)*100/sum(pd)
}
ages <- read.table("taxon_ages_lateral.txt",sep="\t",head=TRUE)
epoch <- read.table("bin_ranges_epoch.txt",sep="\t",head=TRUE)
group_data <- read.table("lateral_group_herb.txt", row.names=1, header=T)
pca_scores$Herb <- as.factor(group_data[,1])
pd_through_t <- matrix(NA,nrow=nlevels(pca_scores$Herb),ncol=nrow(epoch)) #Diet partial disparity per time bin
pd_through_t_perc <- matrix(NA,nrow=nlevels(pca_scores$Herb),ncol=nrow(epoch))
rownames(pd_through_t) <- rownames(pd_through_t_perc) <- levels(pca_scores$Herb)
colnames(pd_through_t) <- colnames(pd_through_t_perc) <- epoch[,1]
for(i in seq_along(epoch$Stage)){
pca_scores_stage <- pca_scores[ages$FAD>=epoch$min.age[i]&ages$LAD<=epoch$max.age[i],]
pca_stage <- prcomp(pca_scores_stage[,1:40],scale. = T)
pd_through_t_perc[,i] <- partial.disparity.as.percentage(pca_stage$x,pca_scores_stage$Herb)
}
pd_through_t_perc
stratplot <- function(xlim){
load("ics2023.Rdata")
plot(NA,xaxs="i",yaxs="i",xlim=xlim,ylim=c(0,3),ax=FALSE,ann=FALSE)
period <- ics[ics$Type=="Period",]
for(i in 1:nrow(period)){
rect(period$Start[i]/1e6,0,period$End[i]/1e6,1,col=period$Color[i])
text((period$Start[i]/1e6+period$End[i]/1e6)/2,.5,period$Name[i])
}
stage <- ics[ics$Type=="Stage",]
stage$Name <- gsub(" .+$","",stage$Name)
for(i in 1:nrow(stage)){
rect(stage$Start[i]/1e6,1,stage$End[i]/1e6,3,col=stage$Color[i])
text((stage$Start[i]/1e6+stage$End[i]/1e6)/2,2,stage$Name[i],cex=1,srt=90)
}
box(lwd=1.5)
axis(1,cex.axis=0.7,at=seq(0,350,1),labels=FALSE)
axis(1,cex.axis=0.7,at=seq(0,350,5),labels=FALSE,lwd=1.5)
axis(1,cex.axis=1,at=seq(0,350,10),lwd=1.5)
mtext("Age (Ma)",1,2.5,cex=1)
}
#Plots
cols <- c('darkolivegreen','firebrick')
layout(matrix(1:2,ncol=1),height=c(2,1))
par(mar=c(0,5,1,5))
plot(NA,xlim=c(346.7,252.2),ylim=c(0,100),xaxs="i",yaxs="i",ann=FALSE,ax=FALSE)
pl <- cbind(c(100,0,0,0,0),pd_through_t_perc,pd_through_t_perc[,ncol(pd_through_t_perc)])
midp <- c(346.7,apply(epoch[,2:3],1,mean),252.2)
pl <- apply(pl,2,cumsum)
for(i in 1:nrow(pl)){
if(i==1){
polygon(c(midp,252.2,346.7),c(pl[i,],0,0),col=cols[i])
}else{
polygon(c(midp,rev(midp)),c(pl[i,],rev(pl[i-1,])),col=cols[i])
}
}
axis(2,at=c(0,25,50,75,100),labels=c("0","0.25","0.5","0.75","1"),las=2)
box(lwd=2)
par(mar=c(5,5,0,5))
stratplot(xlim=c(346.7,252.2))
# plot empty graph with time bins
plot (midpoints, y = results_plot [, "mean"], xlim = x.limits, ylim = y.limits, col = "transparent", xlab = "age (Ma)", ylab = "Disparity (sum of variances)", cex=1.2)
# plot time slices as shaded area
polygon (c(346.7, 330.9, 330.9, 346.7), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
polygon (c(323.2, 315.2, 315.2, 323.2), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
polygon (c(307.0, 303.7,303.7, 307.0), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
polygon (c(298.9, 293.52, 293.52, 298.9), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
polygon (c(290.1, 283.5, 283.5, 290.1), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
polygon (c(273.01, 266.9,266.9, 273.01), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
polygon (c(264.28, 259.51,259.51,264.28), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
polygon (c(254.14, 251.9,251.9, 254.14), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
abline(v=251.9)
abline(v=346.7)
#Non-amniote disparity plot (H2)
nbins<-nrow(bin_ranges)
group_data$Amniote <- read.table("lateral_group_amniote_h2.txt", row.names = 1, header = TRUE)
bin_PA_df <- as.data.frame(bin_PA, stringsAsFactors = FALSE)
bin_PA_df$Amniote <- group_data$Amniote
bin_PA_nonamniote <- bin_PA_df %>% filter(Amniote != "Amniote")
bin_PA_nonamniote <- bin_PA_nonamniote[,-16]
pca_nonamniote <- as.data.frame(pca_scores_shapes)
pca_nonamniote$Amniote <- group_data$Amniote
pca_nonamniote <- pca_nonamniote %>% filter(Amniote != "Amniote")
pca_nonamniote <- pca_nonamniote[,-41]
sov_disparity_nonamniote <- DtT (pca_nonamniote, bin_PA_nonamniote, 1000)
sov_results_mean_nonamniote <- sov_disparity_nonamniote$Variance[1,]
sov_results_lower_nonamniote <- c(sov_disparity_nonamniote$Variance[1,]- sov_disparity_nonamniote$Variance[2,])
sov_results_upper_nonamniote <- c(sov_disparity_nonamniote$Variance[1,] +sov_disparity_nonamniote$Variance[2,])
sov_results_final_time_nonamniote <- data.frame(sov_results_mean_nonamniote, sov_results_lower_nonamniote, sov_results_upper_nonamniote)
colnames(sov_results_final_time_nonamniote) <- c("mean","lower","upper")
rownames(sov_results_final_time_nonamniote) <- names(time.bins)
sov_results_final_time_nonamniote
results_plot_nonamniote <- sov_results_final_time_nonamniote
midpoints_nonamniote <- rowMeans(bin_ranges)
nbins <- nrow(bin_ranges)
nbins<-nrow(bin_ranges)
lines (midpoints_nonamniote, y = results_plot_nonamniote [, "mean"],lty = 2)
points (midpoints_nonamniote, results_plot_nonamniote [, "mean"], pch = 21, col = "black", bg = "white", cex=1.3, lwd=1.4)
#Amniote disparity plot (H2)
nbins<-nrow(bin_ranges)
group_data$Amniote <- read.table("lateral_group_amniote_h2.txt", row.names = 1, header = TRUE)
bin_PA_df <- as.data.frame(bin_PA, stringsAsFactors = FALSE)
bin_PA_df$Amniote <- group_data$Amniote
bin_PA_amniote <- bin_PA_df %>% filter(Amniote != "Non-amniote")
bin_PA_amniote <- bin_PA_amniote[,-16]
pca_amniote <- as.data.frame(pca_scores_shapes)
pca_amniote$Amniote <- group_data$Amniote
pca_amniote <- pca_amniote %>% filter(Amniote != "Non-amniote")
pca_amniote <- pca_amniote[,-41]
sov_disparity_amniote <- DtT (pca_amniote, bin_PA_amniote, 1000)
dev.off()
dev.new()
bin_ranges <- read.table("bin_ranges_epoch.txt", header=T, row.names=1)
bin_ranges
taxon_ages <- read.table ("taxon_ages_lateral.txt", row.names=1, header=T)
taxon_ages
taxon_ages <- as.data.frame(taxon_ages[rownames(pca_scores_shapes),])
taxon_ages
time.bins <- list()
for (i in 1:length(rownames(bin_ranges))) {time.bins[[i]] <- rownames(taxon_ages)[which(taxon_ages$FAD > bin_ranges[i,"min.age"] & taxon_ages$LAD < bin_ranges[i,"max.age"])]}
names(time.bins) <- rownames(bin_ranges)
time.bins
bin_PA <-  matrix(0, nrow=nrow(pca_scores_shapes), ncol=length(time.bins))
rownames(bin_PA) <- rownames(pca_scores_shapes)
bin_PA
for(x in 1:length(time.bins)) {
taxaInHere <- match(time.bins [[x]], rownames(bin_PA))
bin_PA[taxaInHere, x] <- 1
}
bin_PA #Useful overview of taxa per time bin
sov_disparity <- DtT (pca_scores_shapes, bin_PA, 1000)
sov_results_mean <- sov_disparity$Variance[1,]
sov_results_lower <- c(sov_disparity$Variance[1,]- sov_disparity$Variance[2,])
sov_results_upper <- c(sov_disparity$Variance[1,] +sov_disparity$Variance[2,])
sov_results_final_time <- data.frame(sov_results_mean, sov_results_lower, sov_results_upper)
colnames(sov_results_final_time) <- c("mean","lower","upper")
rownames(sov_results_final_time) <- names(time.bins)
sov_results_final_time
results_plot <- sov_results_final_time
#Create limits which will denote the time bins
midpoints <- rowMeans(bin_ranges)
nbins <- nrow(bin_ranges)
# set-up the plotting area
layout (matrix (1:1, 2, 1))
upper.y <- 1.2 * max (results_plot [, "upper"])
lower.y <- 0.8 * min (results_plot [, "lower"])
upper.CI <- results_plot[, "upper"]
lower.CI <- results_plot [, "lower"]
x.limits <- c(max(bin_ranges), min(bin_ranges))
y.limits <- c(lower.y*1.1, upper.y*0.9 )
# plot empty graph with time bins
plot (midpoints, y = results_plot [, "mean"], xlim = x.limits, ylim = y.limits, col = "transparent", xlab = "age (Ma)", ylab = "Disparity (sum of variances)", font=1.5, cex=1.5)
# plot time slices as shaded area
polygon (c(346.7, 330.9, 330.9, 346.7), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
polygon (c(323.2, 315.2, 315.2, 323.2), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
polygon (c(307.0, 303.7,303.7, 307.0), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
polygon (c(298.9, 293.52, 293.52, 298.9), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
polygon (c(290.1, 283.5, 283.5, 290.1), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
polygon (c(273.01, 266.9,266.9, 273.01), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
polygon (c(264.28, 259.51,259.51,264.28), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
polygon (c(254.14, 251.9,251.9, 254.14), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
abline(v=251.9)
abline(v=346.7)
# plot data
nbins<-nrow(bin_ranges)
polygon (c(midpoints, midpoints [nbins:1]), y = c(lower.CI, upper.CI [nbins:1]), border = NA, col = "lightblue")
lines (midpoints, y = results_plot [, "mean"])
points (midpoints, results_plot [, "mean"], pch = 21, col = "black", bg = "white", cex=1.3, lwd=1.4)
#plot disparity data (amniotes vs. non-amniotes)
layout (matrix (1:1, 2, 1))
upper.y <- 1.2 * max (results_plot [, "upper"])
lower.y <- 0.8 * min (results_plot [, "lower"])
upper.CI <- results_plot[, "upper"]
lower.CI <- results_plot [, "lower"]
x.limits <- c(max(bin_ranges), min(bin_ranges))
y.limits <- c(lower.y*1.1, upper.y*0.9 )
# plot empty graph with time bins
plot (midpoints, y = results_plot [, "mean"], xlim = x.limits, ylim = y.limits, col = "transparent", xlab = "age (Ma)", ylab = "Disparity (sum of variances)", cex=1.2)
# plot time slices as shaded area
polygon (c(346.7, 330.9, 330.9, 346.7), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
polygon (c(323.2, 315.2, 315.2, 323.2), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
polygon (c(307.0, 303.7,303.7, 307.0), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
polygon (c(298.9, 293.52, 293.52, 298.9), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
polygon (c(290.1, 283.5, 283.5, 290.1), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
polygon (c(273.01, 266.9,266.9, 273.01), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
polygon (c(264.28, 259.51,259.51,264.28), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
polygon (c(254.14, 251.9,251.9, 254.14), y = c(-1000, -1000, 3000, 3000), border = NA, col = rgb (0, 0, 0, 0.06))
abline(v=251.9)
abline(v=346.7)
#Non-amniote disparity plot (H2)
nbins<-nrow(bin_ranges)
group_data$Amniote <- read.table("lateral_group_amniote_h2.txt", row.names = 1, header = TRUE)
bin_PA_df <- as.data.frame(bin_PA, stringsAsFactors = FALSE)
bin_PA_df$Amniote <- group_data$Amniote
bin_PA_nonamniote <- bin_PA_df %>% filter(Amniote != "Amniote")
bin_PA_nonamniote <- bin_PA_nonamniote[,-16]
pca_nonamniote <- as.data.frame(pca_scores_shapes)
pca_nonamniote$Amniote <- group_data$Amniote
pca_nonamniote <- pca_nonamniote %>% filter(Amniote != "Amniote")
pca_nonamniote <- pca_nonamniote[,-41]
sov_disparity_nonamniote <- DtT (pca_nonamniote, bin_PA_nonamniote, 1000)
sov_results_mean_nonamniote <- sov_disparity_nonamniote$Variance[1,]
sov_results_lower_nonamniote <- c(sov_disparity_nonamniote$Variance[1,]- sov_disparity_nonamniote$Variance[2,])
sov_results_upper_nonamniote <- c(sov_disparity_nonamniote$Variance[1,] +sov_disparity_nonamniote$Variance[2,])
sov_results_final_time_nonamniote <- data.frame(sov_results_mean_nonamniote, sov_results_lower_nonamniote, sov_results_upper_nonamniote)
colnames(sov_results_final_time_nonamniote) <- c("mean","lower","upper")
rownames(sov_results_final_time_nonamniote) <- names(time.bins)
sov_results_final_time_nonamniote
results_plot_nonamniote <- sov_results_final_time_nonamniote
midpoints_nonamniote <- rowMeans(bin_ranges)
nbins <- nrow(bin_ranges)
nbins<-nrow(bin_ranges)
lines (midpoints_nonamniote, y = results_plot_nonamniote [, "mean"],lty = 2)
points (midpoints_nonamniote, results_plot_nonamniote [, "mean"], pch = 21, col = "black", bg = "white", cex=1.3, lwd=1.4)
#Amniote disparity plot (H2)
nbins<-nrow(bin_ranges)
group_data$Amniote <- read.table("lateral_group_amniote_h2.txt", row.names = 1, header = TRUE)
bin_PA_df <- as.data.frame(bin_PA, stringsAsFactors = FALSE)
bin_PA_df$Amniote <- group_data$Amniote
bin_PA_amniote <- bin_PA_df %>% filter(Amniote != "Non-amniote")
bin_PA_amniote <- bin_PA_amniote[,-16]
pca_amniote <- as.data.frame(pca_scores_shapes)
pca_amniote$Amniote <- group_data$Amniote
pca_amniote <- pca_amniote %>% filter(Amniote != "Non-amniote")
pca_amniote <- pca_amniote[,-41]
sov_disparity_amniote <- DtT (pca_amniote, bin_PA_amniote, 1000)
sov_results_mean_amniote <- sov_disparity_amniote$Variance[1,]
sov_results_lower_amniote <- c(sov_disparity_amniote$Variance[1,]- sov_disparity_amniote$Variance[2,])
sov_results_upper_amniote <- c(sov_disparity_amniote$Variance[1,] +sov_disparity_amniote$Variance[2,])
sov_results_final_time_amniote <- data.frame(sov_results_mean_amniote, sov_results_lower_amniote, sov_results_upper_amniote)
colnames(sov_results_final_time_amniote) <- c("mean","lower","upper")
rownames(sov_results_final_time_amniote) <- names(time.bins)
sov_results_final_time_amniote
results_plot_amniote <- sov_results_final_time_amniote
midpoints_amniote <- rowMeans(bin_ranges)
nbins <- nrow(bin_ranges)
nbins<-nrow(bin_ranges)
lines (midpoints_amniote, y = results_plot_amniote [, "mean"])
points (midpoints_amniote, results_plot_amniote [, "mean"], pch = 21, col = "black", bg = "white", cex=1.3, lwd=1.4)
dev.off()
dev.new()
par(mfrow=c(2,2),pin = c(4, 3))
#Herb
plot(x=pca_scores$PC1,y=pca_scores$PC2,
pch=c(22,21) [as.numeric(as.factor(pca_scores$Herb))], cex=1.5,
bg=c('darkolivegreen','firebrick') [as.numeric(as.factor(pca_scores$Herb))],
xlab = ('PC1 (44.55%)'),
ylab = ('PC2 (14.31%)')
)
abline(h = 0, col = rgb(0.5, 0.5, 0.5, 0.5), lty = 2, lwd = 1)
abline(v = 0, col = rgb(0.5, 0.5, 0.5, 0.5), lty = 2, lwd = 1)
legend('topleft',pt.bg=c('darkolivegreen', 'firebrick'),pch=21,pt.cex=0.8,bty='n',
legend=levels(as.factor(pca_scores$Herb)),ncol=1 )
